Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/forms/datawiz/dfd.frm

Text File | 1996-04-12 | 46KB | 1,486 lines

VERSION 4.00
Begin VB.Form frmDFD
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Data Form Wizard"
   ClientHeight    =   6480
   ClientLeft      =   885
   ClientTop       =   630
   ClientWidth     =   8205
   Height          =   6885
   Icon            =   "DFD.frx":0000
   Left            =   825
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6480
   ScaleWidth      =   8205
   Top             =   285
   Width           =   8325
   Begin VB.Frame fraStep
      Caption         =   " Recordsource "
      Height          =   3750
      Index           =   2
      Left            =   1080
      TabIndex        =   6
      Top             =   1200
      Width           =   6750
      Begin VB.ListBox lstSQL
         Height          =   1620
         Left            =   2040
         TabIndex        =   45
         TabStop         =   0   'False
         Top             =   1920
         Width           =   4335
      End
      Begin VB.ComboBox cboRecordSource
         Height          =   315
         Left            =   2040
         TabIndex        =   7
         Top             =   1320
         Width           =   4335
      End
      Begin VB.Label lblSQL
         Caption         =   "Field list reference for Select statement"
         Height          =   975
         Left            =   840
         TabIndex        =   46
         Top             =   1920
         Width           =   1095
         WordWrap        =   -1  'True
      End
      Begin VB.Label Label4
         Caption         =   "2"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   400
            size            =   24
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   495
         Left            =   600
         TabIndex        =   29
         Top             =   360
         Width           =   375
      End
      Begin VB.Line Line1
         BorderWidth     =   3
         X1              =   360
         X2              =   6360
         Y1              =   1080
         Y2              =   1080
      End
      Begin VB.Label lblLabels
         AutoSize        =   -1  'True
         Caption         =   "RecordSource: "
         Height          =   195
         Index           =   6
         Left            =   840
         TabIndex        =   9
         Top             =   1440
         Width           =   1125
      End
      Begin VB.Label lblLabels
         Alignment       =   2  'Center
         Caption         =   "Select a Table/QueryDef from the list or enter a SQL statement.."
         ForeColor       =   &H00FF0000&
         Height          =   495
         Index           =   4
         Left            =   1320
         TabIndex        =   8
         Top             =   480
         Width           =   2445
      End
   End
   Begin VB.Frame fraStep
      Caption         =   " Database "
      Height          =   3750
      Index           =   1
      Left            =   720
      TabIndex        =   1
      Top             =   1320
      Width           =   6750
      Begin VB.CommandButton cmdOpenDB
         Caption         =   "&Open Database..."
         Height          =   375
         Left            =   2040
         TabIndex        =   32
         Top             =   2160
         Width           =   1935
      End
      Begin VB.ComboBox cboConnect
         Height          =   315
         ItemData        =   "DFD.frx":030A
         Left            =   2040
         List            =   "DFD.frx":032C
         TabIndex        =   2
         Top             =   1440
         Width           =   4335
      End
      Begin VB.Label Label3
         Caption         =   "1."
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   400
            size            =   24
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   375
         Left            =   360
         TabIndex        =   34
         Top             =   360
         Width           =   615
      End
      Begin VB.Label Label2
         Caption         =   "Provide a database name and connect string."
         ForeColor       =   &H00FF0000&
         Height          =   375
         Left            =   960
         TabIndex        =   33
         Top             =   480
         Width           =   1935
      End
      Begin MSComDlg.CommonDialog dlgDBOpen
         Left            =   6000
         Top             =   2040
         _Version        =   65536
         _ExtentX        =   847
         _ExtentY        =   847
         _StockProps     =   0
      End
      Begin VB.Label lblLabels
         AutoSize        =   -1  'True
         Caption         =   "Database Name: "
         Height          =   195
         Index           =   1
         Left            =   480
         TabIndex        =   5
         Top             =   2160
         Width           =   1245
      End
      Begin VB.Label lblLabels
         AutoSize        =   -1  'True
         Caption         =   "Connect String: "
         Height          =   195
         Index           =   2
         Left            =   480
         TabIndex        =   4
         Top             =   1500
         Width           =   1140
      End
      Begin VB.Label lblDatabaseName
         ForeColor       =   &H00FF0000&
         Height          =   255
         Left            =   1800
         TabIndex        =   3
         Top             =   3015
         Width           =   4470
         WordWrap        =   -1  'True
      End
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   5280
      TabIndex        =   43
      Top             =   5520
      Width           =   1455
   End
   Begin VB.CommandButton cmdMove
      Caption         =   "<< &Previous"
      Height          =   375
      Index           =   1
      Left            =   240
      TabIndex        =   42
      Top             =   5520
      Width           =   1335
   End
   Begin VB.CommandButton cmdMove
      Caption         =   "&Next >>"
      Height          =   375
      Index           =   0
      Left            =   1680
      TabIndex        =   41
      Top             =   5520
      Width           =   1335
   End
   Begin VB.Frame fraStep
      Caption         =   "Form info "
      Height          =   3750
      Index           =   5
      Left            =   3360
      TabIndex        =   25
      Top             =   1560
      Width           =   6750
      Begin VB.CheckBox chkOnScreen
         Caption         =   "On Screen"
         Height          =   210
         Left            =   240
         TabIndex        =   44
         Top             =   3240
         Value           =   1  'Checked
         Width           =   1875
      End
      Begin VB.TextBox txtFormName
         Height          =   285
         Left            =   3615
         MaxLength       =   8
         TabIndex        =   30
         Top             =   2760
         Width           =   1095
      End
      Begin VB.CheckBox chkLineUnder
         Caption         =   "Line Under Headline"
         Height          =   255
         Left            =   1080
         TabIndex        =   27
         Top             =   2040
         Width           =   2415
      End
      Begin VB.TextBox txtHeadline
         Height          =   285
         Left            =   1080
         TabIndex        =   26
         Top             =   1560
         Width           =   2775
      End
      Begin VB.Label Label7
         Caption         =   "5"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   400
            size            =   24
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   495
         Left            =   360
         TabIndex        =   40
         Top             =   240
         Width           =   375
      End
      Begin VB.Label lblLabels
         Alignment       =   2  'Center
         Caption         =   "Select a caption for the top of form and a formname."
         ForeColor       =   &H00FF0000&
         Height          =   495
         Index           =   9
         Left            =   960
         TabIndex        =   39
         Top             =   480
         Width           =   2445
      End
      Begin VB.Label lblLabels
         AutoSize        =   -1  'True
         Caption         =   "Base Form Name (w/o Extension): "
         Height          =   195
         Index           =   0
         Left            =   960
         TabIndex        =   31
         Top             =   2760
         Width           =   2460
      End
      Begin VB.Label Label1
         Caption         =   "Headline"
         Height          =   255
         Left            =   1080
         TabIndex        =   28
         Top             =   1200
         Width           =   1215
      End
   End
   Begin VB.Frame fraStep
      Caption         =   " Appearance "
      Height          =   3750
      Index           =   4
      Left            =   1560
      TabIndex        =   21
      Top             =   1320
      Width           =   6750
      Begin VB.OptionButton optLook
         Caption         =   "3D"
         Height          =   255
         Index           =   0
         Left            =   2640
         TabIndex        =   24
         Top             =   1320
         Width           =   855
      End
      Begin VB.OptionButton optLook
         Caption         =   "2D"
         Height          =   255
         Index           =   1
         Left            =   2640
         TabIndex        =   23
         Top             =   1680
         Width           =   855
      End
      Begin VB.OptionButton optLook
         Caption         =   "View "
         Height          =   255
         Index           =   2
         Left            =   2640
         TabIndex        =   22
         Top             =   2040
         Width           =   855
      End
      Begin VB.Label Label6
         Caption         =   "4"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   400
            size            =   24
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   495
         Left            =   720
         TabIndex        =   38
         Top             =   240
         Width           =   375
      End
      Begin VB.Label lblLabels
         Alignment       =   2  'Center
         Caption         =   "Select a look for the controls you create"
         ForeColor       =   &H00FF0000&
         Height          =   495
         Index           =   8
         Left            =   1440
         TabIndex        =   37
         Top             =   360
         Width           =   2445
      End
   End
   Begin VB.Frame fraStep
      Caption         =   " Fields to include "
      Height          =   3750
      Index           =   3
      Left            =   2400
      TabIndex        =   10
      Top             =   120
      Width           =   6750
      Begin VB.ListBox lstFields
         DragIcon        =   "DFD.frx":039B
         Height          =   1620
         Left            =   480
         MultiSelect     =   2  'Extended
         TabIndex        =   17
         Top             =   1200
         Width           =   2535
      End
      Begin VB.ListBox lstIncludedFields
         DragIcon        =   "DFD.frx":06A5
         Height          =   1620
         Left            =   3720
         MultiSelect     =   2  'Extended
         TabIndex        =   16
         Top             =   1200
         Width           =   2655
      End
      Begin VB.CommandButton cmdMoveFields
         Caption         =   ">>"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   700
            size            =   8.25
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   0
         Left            =   3120
         TabIndex        =   15
         Top             =   1200
         Width           =   495
      End
      Begin VB.CommandButton cmdMoveFields
         Caption         =   ">"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   700
            size            =   8.25
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   1
         Left            =   3120
         TabIndex        =   14
         Top             =   1680
         Width           =   495
      End
      Begin VB.CommandButton cmdMoveFields
         Caption         =   "<"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   700
            size            =   8.25
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   2
         Left            =   3120
         TabIndex        =   13
         Top             =   2160
         Width           =   495
      End
      Begin VB.CommandButton cmdMoveFields
         Caption         =   "<<"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   700
            size            =   8.25
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   3
         Left            =   3120
         TabIndex        =   12
         Top             =   2640
         Width           =   495
      End
      Begin VB.ListBox lstOLECtls
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   700
            size            =   8.25
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         Height          =   450
         Left            =   480
         TabIndex        =   11
         Top             =   2760
         Visible         =   0   'False
         Width           =   615
      End
      Begin VB.Label Label5
         Caption         =   "3"
         BeginProperty Font
            name            =   "MS Sans Serif"
            charset         =   0
            weight          =   400
            size            =   24
            underline       =   0   'False
            italic          =   0   'False
            strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   495
         Left            =   480
         TabIndex        =   36
         Top             =   240
         Width           =   375
      End
      Begin VB.Label lblLabels
         Alignment       =   2  'Center
         Caption         =   "Select fields and field order."
         ForeColor       =   &H00FF0000&
         Height          =   255
         Index           =   5
         Left            =   1320
         TabIndex        =   35
         Top             =   360
         Width           =   2445
      End
      Begin VB.Label lblLabels
         AutoSize        =   -1  'True
         Caption         =   " Drag/Drop to Change Order "
         ForeColor       =   &H00FF0000&
         Height          =   195
         Index           =   7
         Left            =   1440
         TabIndex        =   20
         Top             =   600
         Width           =   2070
      End
      Begin VB.Label lblLabels
         AutoSize        =   -1  'True
         Caption         =   "Available Columns: "
         Height          =   195
         Index           =   3
         Left            =   480
         TabIndex        =   19
         Top             =   960
         Width           =   1380
      End
      Begin VB.Label lblLabels
         AutoSize        =   -1  'True
         Caption         =   "Included Columns: "
         Height          =   195
         Index           =   10
         Left            =   3720
         TabIndex        =   18
         Top             =   960
         Width           =   1350
      End
   End
   Begin VB.CommandButton cmdFinish
      Caption         =   "&Build the Form"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3720
      TabIndex        =   0
      Top             =   5520
      Width           =   1455
   End
End
Attribute VB_Name = "frmDFD"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Dim mdbCurrentDB As Database
Dim msDBName As String
Dim mrecRS As Recordset
Dim mnDataType As Integer

'set in the look panel
Public iScreenStyle As Integer

'constants used for the data type of the database
Const gnDT_NONE = -1
Const gnDT_ACCESS = 0
Const gnDT_DBASEIV = 1
Const gnDT_DBASEIII = 2
Const gnDT_FOXPRO26 = 3
Const gnDT_FOXPRO25 = 4
Const gnDT_FOXPRO20 = 5
Const gnDT_PARADOX4X = 6
Const gnDT_PARADOX3X = 7
Const gnDT_BTRIEVE = 8
Const gnDT_ODBC = 9

'dealing with screen types
Const Screen_3d = 0
Const Screen_2d = 1
Const Screen_View = 2
Private Sub cboConnect_Change()
  msDBName = ""
  mnDataType = gnDT_NONE
  lblDatabaseName.Caption = msDBName
  cboRecordSource.Clear
  Set mrecRS = Nothing
  lstFields.Clear
  lstIncludedFields.Clear
End Sub

Private Sub cboConnect_Click()
  Call cboConnect_Change
  mnDataType = cboConnect.ListIndex
End Sub

Private Sub cboRecordSource_Change()
  Set mrecRS = Nothing
  lstFields.Clear
  lstIncludedFields.Clear
End Sub

Private Sub cboRecordSource_Click()
  Call cboRecordSource_LostFocus
End Sub

Private Sub cboRecordSource_LostFocus()
  On Error GoTo RSErr

  Dim i As Integer
  Dim fld As Field

  If Len(cboRecordSource.Text) = 0 Then Exit Sub

  Screen.MousePointer = 11
  'this code clears out the current field list
  'and gets the new fields from the new recordset
  If mrecRS Is Nothing Then
    Set mrecRS = mdbCurrentDB.OpenRecordset(cboRecordSource.Text)
    For Each fld In mrecRS.Fields
      lstFields.AddItem fld.Name
    Next
  ElseIf mrecRS.Name <> cboRecordSource.Text Then
    lstFields.Clear
    lstIncludedFields.Clear
    Set mrecRS = mdbCurrentDB.OpenRecordset(cboRecordSource.Text)
    For Each fld In mrecRS.Fields
      lstFields.AddItem fld.Name
    Next
  End If

  Screen.MousePointer = 0
  Exit Sub

RSErr:
  Screen.MousePointer = 0
  MsgBox Err.Description
  Exit Sub

End Sub




Private Sub cmdCancel_Click()
Unload Me 'and do nothing else

End Sub

Private Sub cmdFinish_Click()

  If Len(txtFormName.Text) = 0 Then
    MsgBox "Form Name cannot be blank!", 16
    txtFormName.SetFocus
    Exit Sub
  End If

  If InStr(txtFormName.Text, " ") > 0 Then
    MsgBox "Form Name cannot have spaces in it!", 16
    txtFormName.SetFocus
    Exit Sub
  End If

  If mdbCurrentDB Is Nothing Then
    MsgBox "You must open a Database!", 16
    Exit Sub
  End If

  If Len(cboRecordSource.Text) = 0 Then
    MsgBox "You must enter a RecordSource!", 16
    Exit Sub
  End If

  If lstIncludedFields.ListCount = 0 Then
    MsgBox "You must include some Columns!", 16
    Exit Sub
  End If

   Screen.MousePointer = vbHourglass
  If chkOnScreen.Value = vbChecked Then
    BuildFormOnScreen
  Else
    'BuildFormFile 'we dont do this in this version
  End If

  Screen.MousePointer = vbDefault

  MsgBox "The Data Form Wizard by:" & _
    vbCrLf & "Gervase Gallant (email: [e-mail])" & _
    vbCrLf & "from the Data Form Designer source code.", 48, "Wizard"

  Unload Me

End Sub

Private Sub cmdMove_Click(Index As Integer)
Const Step_previous = 1
Const Step_next = 0

Static ThisIndex As Integer

'start at 1, not step 0
If ThisIndex = 0 Then ThisIndex = 1

Select Case Index
Case Step_previous

    ThisIndex = ThisIndex - 1
    fraStep(ThisIndex).ZOrder 0


    If ThisIndex = 1 Then
        cmdMove(Index).Enabled = False
    Else
        cmdMove(1).Enabled = True
        cmdMove(0).Enabled = True
    End If

Case Step_next
    ThisIndex = ThisIndex + 1
    fraStep(ThisIndex).ZOrder 0


    If ThisIndex = 5 Then
        cmdMove(Index).Enabled = False
    Else
        cmdMove(0).Enabled = True
        cmdMove(1).Enabled = True
    End If

End Select

'when to enable the Finish button
If ThisIndex = 5 Then
    cmdFinish.Enabled = True
Else
    cmdFinish.Enabled = False
End If

End Sub

Private Sub cmdMoveFields_Click(Index As Integer)
  Dim i As Integer
  Select Case Index
    Case 0
      For i = 0 To lstFields.ListCount - 1
        lstIncludedFields.AddItem lstFields.List(i)
      Next
      lstFields.Clear
    Case 1
      If lstFields.ListIndex = -1 Then Exit Sub
      For i = lstFields.ListCount - 1 To 0 Step -1
        If lstFields.Selected(i) = True Then
          lstIncludedFields.AddItem lstFields.List(i)
          lstFields.RemoveItem i
        End If
      Next
    Case 2
      If lstIncludedFields.ListIndex = -1 Then Exit Sub
      For i = lstIncludedFields.ListCount - 1 To 0 Step -1
        If lstIncludedFields.Selected(i) = True Then
          lstFields.AddItem lstIncludedFields.List(i)
          lstIncludedFields.RemoveItem i
        End If
      Next
    Case 3
      For i = 0 To lstIncludedFields.ListCount - 1
        lstFields.AddItem lstIncludedFields.List(i)
      Next
      lstIncludedFields.Clear
  End Select
End Sub

Private Sub cmdSQL_Click()
'added by Gervase



End Sub

Sub Form_Load()
Dim i As Integer

  Me.Height = 4750
  Me.Width = fraStep(1).Width + 350

  'center it on the screen
  Me.Top = (Screen.Height - Me.Height) \ 2
  Me.Left = (Screen.Width - Me.Width) \ 2
  #If Win32 Then
    chkOnScreen.Value = vbChecked
    chkOnScreen.Visible = False
  #End If
  cboConnect.ListIndex = 0

'position the frames
For i = 1 To 5
    fraStep(i).Top = 100
    fraStep(i).Left = 100
Next

'move first frame to top
fraStep(1).ZOrder 0

'position the buttons
For i = 0 To 1
    cmdMove(i).Top = fraStep(1).Top + fraStep(1).Height + 100
Next

cmdFinish.Top = fraStep(1).Top + fraStep(1).Height + 100
cmdCancel.Top = fraStep(1).Top + fraStep(1).Height + 100

End Sub

Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next
  Dim rsTmp As Recordset
  'close all open recordsets
  For Each rsTmp In mdbCurrentDB.Recordsets
    rsTmp.Close
  Next
  'close the database
  mdbCurrentDB.Close
End Sub






Sub lstIncludedFields_DragDrop(Source As Control, X As Single, Y As Single)
  Dim sTmp As String
  Dim nPos As Integer

  If Source = lstIncludedFields Then
    If lstIncludedFields.ListIndex >= 0 Then
      sTmp = lstIncludedFields.List(lstIncludedFields.ListIndex)
      nPos = (Y / TextHeight(sTmp)) + lstIncludedFields.TopIndex
      'check for the last item
      If nPos > lstIncludedFields.ListCount Then
        nPos = lstIncludedFields.ListCount
      End If
      lstIncludedFields.AddItem sTmp, nPos
      If lstIncludedFields.ListIndex > nPos Then
        lstIncludedFields.RemoveItem lstIncludedFields.ListIndex + 1
      Else
        lstIncludedFields.RemoveItem lstIncludedFields.ListIndex
      End If
    End If
    Source.MousePointer = 0
  End If

End Sub

Private Sub cmdOpenDB_Click()
  On Error GoTo OpenError

  Dim sConnect As String
  Dim sDatabaseName As String
  Dim tdf As TableDef
  Dim qdf As QueryDef
  Dim fld As Field

  Select Case mnDataType
    Case gnDT_ACCESS
      dlgDBOpen.Filter = "Access DBs (*.mdb)|*.mdb|All Files (*.*)|*.*"
      dlgDBOpen.DialogTitle = "Open MS Access Database"
    Case gnDT_BTRIEVE
      dlgDBOpen.Filter = "Btrieve DBs (FILE.DDF)|FILE.DDF"
      dlgDBOpen.DialogTitle = "Open Btrieve Database"
    Case gnDT_DBASEIII
      dlgDBOpen.Filter = "dBASE III DBs (*.dbf)|*.dbf"
      dlgDBOpen.DialogTitle = "Open dBASE III Database"
    Case gnDT_DBASEIV
      dlgDBOpen.Filter = "dBASE IV DBs (*.dbf)|*.dbf"
      dlgDBOpen.DialogTitle = "Open dBASE IV Database"
    Case gnDT_FOXPRO20
      dlgDBOpen.Filter = "FoxPro DBs (*.dbf)|*.dbf"
      dlgDBOpen.DialogTitle = "Open FoxPro 2.0 Database"
    Case gnDT_FOXPRO25
      dlgDBOpen.Filter = "FoxPro DBs (*.dbf)|*.dbf"
      dlgDBOpen.DialogTitle = "Open FoxPro 2.5 Database"
    Case gnDT_FOXPRO26
      dlgDBOpen.Filter = "FoxPro DBs (*.dbf)|*.dbf"
      dlgDBOpen.DialogTitle = "Open FoxPro 2.6 Database"
    Case gnDT_PARADOX3X
      dlgDBOpen.Filter = "Paradox DBs (*.db)|*.db"
      dlgDBOpen.DialogTitle = "Open Paradox 3.X Database"
    Case gnDT_PARADOX4X
      dlgDBOpen.Filter = "Paradox DBs (*.db)|*.db"
      dlgDBOpen.DialogTitle = "Open Paradox 4.X Database"
    Case Else
      If UCase(Left(cboConnect.Text, 4)) = "ODBC" Then
        'default to ODBC
        mnDataType = gnDT_ODBC
      Else
        Beep
        MsgBox "Invalid Connect String!", 48
        Exit Sub
      End If
  End Select

  If mnDataType <> gnDT_ODBC Then
    With dlgDBOpen
      .FilterIndex = 1
      .FileName = msDBName  '""
      .CancelError = True
      .Flags = &H4
      .Action = 1
    End With

    msDBName = dlgDBOpen.FileName
  Else
    msDBName = ""
  End If

  lblDatabaseName.Caption = msDBName
  cboRecordSource.Clear
  lstSQL.Clear
  Set mrecRS = Nothing
  lstFields.Clear
  lstIncludedFields.Clear
  Me.Refresh       'repaint the form to get rid og the common dialog

  Select Case mnDataType
    Case gnDT_ACCESS
      sConnect = ""
      sDatabaseName = msDBName
    Case gnDT_DBASEIII
      sConnect = "dBASE III"
      sDatabaseName = StripFileName(msDBName)
    Case gnDT_DBASEIV
      sConnect = "dBASE IV"
      sDatabaseName = StripFileName(msDBName)
    Case gnDT_FOXPRO20
      sConnect = "FoxPro 2.0"
      sDatabaseName = StripFileName(msDBName)
    Case gnDT_FOXPRO25
      sConnect = "FoxPro 2.5"
      sDatabaseName = StripFileName(msDBName)
    Case gnDT_PARADOX3X
      sConnect = "Paradox 3.X"
      sDatabaseName = StripFileName(msDBName)
    Case gnDT_PARADOX4X
      sConnect = "Paradox 4.X"
      sDatabaseName = StripFileName(msDBName)
    Case gnDT_BTRIEVE
      sConnect = "Btrieve;"
      sDatabaseName = msDBName
    Case Else
      sConnect = cboConnect.Text
      sDatabaseName = msDBName
  End Select

  Screen.MousePointer = 11 'set the hourglass
  Set mdbCurrentDB = OpenDatabase(sDatabaseName, False, True, sConnect)

  'set the connect string for an ODBC datasource
  If mnDataType = gnDT_ODBC Then
    cboConnect.Text = mdbCurrentDB.Connect
  End If

  For Each tdf In mdbCurrentDB.TableDefs
    If (tdf.Attributes And &H80000002) = 0 Then
      cboRecordSource.AddItem tdf.Name
      lstSQL.AddItem "TABLE: " & tdf.Name
      lstSQL.AddItem "------------------------"
      For Each fld In tdf.Fields
        lstSQL.AddItem tdf.Name & "." & fld.Name
      Next
      lstSQL.AddItem "------------------------"
    End If
  Next
  If mnDataType = gnDT_ACCESS Then
    For Each qdf In mdbCurrentDB.QueryDefs
      cboRecordSource.AddItem qdf.Name
      lstSQL.AddItem "QUERYDEF: " & qdf.Name
      lstSQL.AddItem "------------------------"
      For Each fld In qdf.Fields
        lstSQL.AddItem qdf.Name & "." & fld.Name
      Next
      lstSQL.AddItem "------------------------"
    Next
  End If

  cboRecordSource.ListIndex = 0
  Screen.MousePointer = 0 'unset the hourglass

  Exit Sub

OpenError:
  Screen.MousePointer = 0 'unset the hourglass
  If Err <> 32755 Then     'check for common dialog cancelled
    MsgBox Err.Description
  End If
  Exit Sub

End Sub

Private Sub lstIncludedFields_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = 1 Then lstIncludedFields.Drag
End Sub

Sub BuildFormOnScreen()
  On Error GoTo BuildErr

  Dim i As Integer, iThis As Integer, iAddtoTop As Integer
  Dim sTmp As String
  Dim nNumFlds As Integer
  Dim frmNewForm As vbide.FormTemplate
  Dim nButtonTop As Integer
  Dim iHiddenLeft As Integer
  Dim iFieldHeight As Integer

 'just how many fields do you want to display??
  Const MAX_Fields = 50
  Const QB_RED = 12

  'assign height of fields
  Select Case iScreenStyle
  Case Screen_3d
    iFieldHeight = 320 'standard height of 3d fields
  Case Screen_2d
    iFieldHeight = 285 '2d height
  Case Screen_View
    iFieldHeight = 225   'view only (transparent, borderless...)
  End Select

  'deal with too many fields
  If lstIncludedFields.ListCount > MAX_Fields Then
    MsgBox "You have requested" & Str$(lstIncludedFields.ListCount) & _
          ". However, only" & Str$(MAX_Fields) & " can be displayed.", _
          vbExclamation, App.Title
    nNumFlds = MAX_Fields
  Else
    nNumFlds = lstIncludedFields.ListCount
  End If

  lstOLECtls.Clear

  'create the new form
  Set frmNewForm = gobjIDEAppInst.ActiveProject.AddFormTemplate()

'make room for the headline and line
If txtHeadline.Text = "" Then
  iAddtoTop = 0
Else
  iAddtoTop = 700
End If

  'form height = iFieldHeight * numflds + 1260 for buttons and data control
  'form width = 5640
  With frmNewForm.Properties
    .Item("Caption") = Left(mrecRS.Name, 32)
    .Item("Height") = 1115 + (nNumFlds * iFieldHeight) + iAddtoTop
    .Item("Name") = "frm" & txtFormName.Text
    .Item("Width") = 5640
    .Item("Left") = 1050
  End With
  iHiddenLeft = -5640

   'add headline to top
   If txtHeadline.Text <> "" Then

    With frmNewForm.ControlTemplates.Add("label").Properties
     .Item("Name") = "lblHeadline"
     .Item("left") = 120
     .Item("top") = 50
     .Item("caption") = txtHeadline.Text
     .Item("autosize") = True
     .Item("forecolor") = QBColor(QB_RED)

     '*************************************
     'AAARGH!!!!!!
     'ATTEMPTS BELOW: all of these failed
     '.Item("font").Properties("bold").Value = 0
     '.Item("font(0)") = True
     '.Item("font(3)") = 24
     '.item("font.size")  = 24

     'YOU CAN actually nest like this at runtime
     'but not here
      'with .item("font")
        '.Item("bold") = True
      'end with
      '*******************************************

   End With

'***********************************************************************
' since the headline was the first control I made, I was able to reference it
' as the first element of the ControlTemplates collection, which spared me
'from having to loop through the collection to find my headline
frmNewForm.ControlTemplates(0).Properties("font").Value("bold").Value = False
frmNewForm.ControlTemplates(0).Properties("font").Value("size").Value = 24



  If chkLineUnder.Value Then
        With frmNewForm.ControlTemplates.Add("line").Properties
            .Item("x1") = 120
            .Item("Y1") = iAddtoTop - 50
            .Item("x2") = 5640 - 240
            .Item("y2") = iAddtoTop - 50
            .Item("Name") = "lineHeadline"
            .Item("BorderWidth") = 1
            .Item("bordercolor") = QBColor(12)

        End With
    End If
  End If


  'labels.left") = 120, .width") = 1815, .height = 255
  'fields.left = 2040, .width = 3375, .height = 285
  For i = 0 To nNumFlds - 1
    sTmp = lstIncludedFields.List(i)
    With frmNewForm.ControlTemplates.Add("Label").Properties
      .Item("Left") = iHiddenLeft
      .Item("Caption") = sTmp & ":"
      .Item("Height") = 255
      .Item("Index") = i
      .Item("Name") = "lblLabels"
      .Item("Top") = (i * iFieldHeight) + 60 + iAddtoTop
      .Item("Width") = 1815
      .Item("Left") = 120
    End With
    If mrecRS.Fields(sTmp).Type = 1 Then
      'true/false field
      With frmNewForm.ControlTemplates.Add("CheckBox").Properties
        .Item("Left") = iHiddenLeft
        .Item("Caption") = ""
        .Item("Height") = 285
        .Item("Index") = i
        .Item("Name") = "chkFields"
        .Item("Top") = (i * iFieldHeight) + 40 + iAddtoTop
        .Item("Width") = 3375
        .Item("DataSource") = "Data1"
        .Item("DataField") = sTmp
        .Item("Left") = 2040
      End With
    ElseIf mrecRS.Fields(sTmp).Type = 11 Then
      'picture field
      With frmNewForm.ControlTemplates.Add("OLE").Properties
        .Item("Left") = iHiddenLeft
        .Item("Height") = 285
        .Item("Name") = "oleField" & i
        .Item("OLETypeAllowed") = 1
        .Item("Top") = (i * iFieldHeight) + 40 + iAddtoTop
        .Item("Width") = 3375
        .Item("DataSource") = "Data1"
        .Item("DataField") = sTmp
        .Item("Left") = 2040
      End With
      SendKeys "{Esc}"
      lstOLECtls.AddItem i
    Else
      With frmNewForm.ControlTemplates.Add("TextBox").Properties
        .Item("Left") = iHiddenLeft
        .Item("Index") = i
        .Item("Name") = "txtFields"
        .Item("Text") = ""
        If mrecRS.Fields(sTmp).Type < 10 Then
          'numeric or date
          .Item("Width") = 1935
        Else
          'string or memo
          .Item("Width") = 3375

        End If
        .Item("DataSource") = "Data1"
        .Item("DataField") = sTmp
        If mrecRS.Fields(sTmp).Type = 10 Then
          .Item("Height") = 285
          .Item("Top") = (i * iFieldHeight) + 40 + iAddtoTop
          .Item("MaxLength") = mrecRS.Fields(sTmp).Size
        ElseIf mrecRS.Fields(sTmp).Type = 12 Then
          .Item("Height") = 310
          .Item("Top") = (i * iFieldHeight) + 30 + iAddtoTop
          .Item("MultiLine") = True
          .Item("ScrollBars") = 2
        Else
          .Item("Height") = 285
          .Item("Top") = (i * iFieldHeight) + 40 + iAddtoTop
        End If
        .Item("Left") = 2040

        '**************************************
        'APPEARANCE: how you switch from 3d to 2d to Flat


        Select Case iScreenStyle

            Case Screen_3d
                'do nothing
                .Item("appearance") = 1
            Case Screen_2d
                .Item("Appearance") = 0
            Case Screen_View
                .Item("Appearance") = 0
                .Item("backcolor") = &HE0E0E0 'grey it out??
                .Item("borderstyle") = 0
                .Item("Locked") = True
        End Select


        '*******************************************************
      End With
    End If
  Next
  nButtonTop = i * iFieldHeight + 120  'still can't figure why an extra 120!


  'add the data control and buttons
  With frmNewForm.ControlTemplates.Add("Data").Properties
    .Item("Left") = iHiddenLeft
    .Item("Caption") = ""
    .Item("DatabaseName") = mdbCurrentDB.Name
    .Item("Connect") = mdbCurrentDB.Connect
    .Item("RecordSource") = cboRecordSource.Text
    .Item("Align") = 2 'toolbar type
  End With
'*******************************************************
'if screen is View then don't add, delete,update,refresh
  If iScreenStyle <> Screen_View Then
    With frmNewForm.ControlTemplates.Add("CommandButton").Properties
      .Item("Left") = iHiddenLeft
      .Item("Caption") = "&Add"
      .Item("Height") = 300
      .Item("Name") = "cmdAdd"
      .Item("Top") = nButtonTop + iAddtoTop
      .Item("Width") = 975
      .Item("Left") = 120
    End With

    With frmNewForm.ControlTemplates.Add("CommandButton").Properties
    .Item("Left") = iHiddenLeft
    .Item("Caption") = "&Delete"
    .Item("Height") = 300
    .Item("Name") = "cmdDelete"
    .Item("Top") = nButtonTop + iAddtoTop
    .Item("Width") = 975
    .Item("Left") = 1200
  End With
  With frmNewForm.ControlTemplates.Add("CommandButton").Properties
    .Item("Left") = iHiddenLeft
    .Item("Caption") = "&Refresh"
    .Item("Height") = 300
    .Item("Name") = "cmdRefresh"
    .Item("Top") = nButtonTop + iAddtoTop
    .Item("Width") = 975
    .Item("Left") = 2280
  End With
  With frmNewForm.ControlTemplates.Add("CommandButton").Properties
    .Item("Left") = iHiddenLeft
    .Item("Caption") = "&Update"
    .Item("Height") = 300
    .Item("Name") = "cmdUpdate"
    .Item("Top") = nButtonTop + iAddtoTop
    .Item("Width") = 975
    .Item("Left") = 3360
  End With
End If

  With frmNewForm.ControlTemplates.Add("CommandButton").Properties
    .Item("Left") = iHiddenLeft
    .Item("Caption") = "&Close"
    .Item("Height") = 300
    .Item("Name") = "cmdClose"
    .Item("Top") = nButtonTop + iAddtoTop
    .Item("Width") = 975
    .Item("Left") = 4440
  End With

  'add the code to the form
  Dim fh As Integer
  fh = FreeFile
  Open App.Path & "\DFD_FRM.MOD" For Output As fh
  WriteFrmCode fh
  Close fh

  frmNewForm.InsertFile App.Path & "\DFD_FRM.MOD"
  Kill App.Path & "\DFD_FRM.MOD"

  'save the new form
  gobjIDEAppInst.ActiveProject.SelectedComponents(0).SaveAs (gobjIDEAppInst.LastUsedPath & "\" & txtFormName & ".FRM")

  'set the form back to defaults
  txtFormName.Text = ""
  cboRecordSource.Text = ""
  'try to set focus back to the form
  Me.SetFocus
  txtFormName.SetFocus
  Exit Sub

BuildErr:
  MsgBox Err.Description
  Resume Next

End Sub


Sub BuildFormFile()
  On Error GoTo BuildFErr

  Dim i As Integer
  Dim sTmp As String
  Dim nNumFlds As Integer
  Dim frmNewForm As Object
  Dim ctlNewControl As Object
  Dim nButtonTop As Integer


  'create and open the file
  Dim nFileHnd As Integer
  nFileHnd = FreeFile
  Open gobjIDEAppInst.LastUsedPath & "\" & txtFormName & ".FRM" For Output As nFileHnd
  Print #nFileHnd, "VERSION 4.00"



  nNumFlds = lstIncludedFields.ListCount
  lstOLECtls.Clear

  Print #nFileHnd, "Begin VB.Form frm" & txtFormName.Text

  'form height = 320 * numflds + 1260 for buttons and data control
  'form width = 5640
  Print #nFileHnd, "   Caption = """ & Left(mrecRS.Name, 32) & """"
  Print #nFileHnd, "   Height       = " & 1115 + (nNumFlds * 320)
  Print #nFileHnd, "   Left         = 2400"
  Print #nFileHnd, "   Top          = 2040"
  Print #nFileHnd, "   Width        = 5640"

  'labels.left = 120, .width = 1815, .height = 255
  'fields.left = 2040, .width = 3375, .height = 285
  For i = 0 To nNumFlds - 1
    sTmp = lstIncludedFields.List(i)
    Print #nFileHnd, "   Begin VB.Label lblLabels"
    Print #nFileHnd, "      Caption = """ & sTmp & ":"""
    Print #nFileHnd, "      Height  = 255"
    Print #nFileHnd, "      Index   = " & i
    Print #nFileHnd, "      Left    = 120"
    Print #nFileHnd, "      Top     = " & (i * 320) + 60
    Print #nFileHnd, "      Width   = 1815"
    Print #nFileHnd, "   End"
    If mrecRS.Fields(sTmp).Type = 1 Then
      'true/false field
      Print #nFileHnd, "   Begin VB.CheckBox chkField" & i
      Print #nFileHnd, "      DataField  = """ & sTmp & """"
      Print #nFileHnd, "      DataSource = ""Data1"""
      Print #nFileHnd, "      Height     = 285"
      Print #nFileHnd, "      Index      = " & i
      Print #nFileHnd, "      Left       = 2040"
      Print #nFileHnd, "      Top        = " & (i * 320) + 40
      Print #nFileHnd, "      Width      = 3375"
      Print #nFileHnd, "   End"
    ElseIf mrecRS.Fields(sTmp).Type = 11 Then
      'picture field
      Print #nFileHnd, "   Begin VB.OLE oleField" & i
      Print #nFileHnd, "      DataField      = """ & sTmp & """"
      Print #nFileHnd, "      DataSource     = ""Data1"""
      Print #nFileHnd, "      Height         = 285"
      Print #nFileHnd, "      Left           = 2040"
      Print #nFileHnd, "      OLETypeAllowed = 1"
      Print #nFileHnd, "      Top            = " & (i * 320) + 40
      Print #nFileHnd, "      Width          = 3375"
      Print #nFileHnd, "   End"
      lstOLECtls.AddItem i
    Else
      Print #nFileHnd, "   Begin VB.TextBox txtField" & i
      Print #nFileHnd, "      DataField  = """ & sTmp & """"
      Print #nFileHnd, "      DataSource = ""Data1"""
      If mrecRS.Fields(sTmp).Type = 12 Then
        Print #nFileHnd, "      Height     = 310"
      Else
        Print #nFileHnd, "      Height     = 285"
      End If
      Print #nFileHnd, "      Index      = " & i
      Print #nFileHnd, "      Left       = 2040"
      If mrecRS.Fields(sTmp).Type = 10 Then
        Print #nFileHnd, "      MaxLength   = " & mrecRS.Fields(sTmp).Size
      End If
      If mrecRS.Fields(sTmp).Type = 12 Then
        Print #nFileHnd, "      MultiLine   = True"
      End If
      If mrecRS.Fields(sTmp).Type = 12 Then
        Print #nFileHnd, "      ScrollBars  = 2"
      End If
      Print #nFileHnd, "      Top        = " & (i * 320) + 40
      Print #nFileHnd, "      Text       = """""
      If mrecRS.Fields(sTmp).Type < 10 Then
        'numeric or date
        Print #nFileHnd, "      Width      = 1935"
      Else
        'string or memo
        Print #nFileHnd, "      Width      = 3375"
      End If
      Print #nFileHnd, "   End"
    End If
  Next
  nButtonTop = (((i - 1) * 320) + 40) + 340

  'add the data control and buttons
  Print #nFileHnd, "   Begin VB.Data Data1"
  Print #nFileHnd, "      Align        = 2"
  Print #nFileHnd, "      Caption      = """""
  Print #nFileHnd, "      Connect      = """ & mdbCurrentDB.Connect & """"
  Print #nFileHnd, "      DatabaseName = """ & mdbCurrentDB.Name & """"
  Print #nFileHnd, "      RecordSource = """ & cboRecordSource.Text & """"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdAdd"
  Print #nFileHnd, "      Caption      = ""&Add"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 120"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdDelete"
  Print #nFileHnd, "      Caption      = ""&Delete"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 1200"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdRefresh"
  Print #nFileHnd, "      Caption      = ""&Refresh"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 2280"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdUpdate"
  Print #nFileHnd, "      Caption      = ""&Update"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 3360"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdClose"
  Print #nFileHnd, "      Caption      = ""&Close"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 4440"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "End"
  Print #nFileHnd, ""
  Print #nFileHnd, "Attribute VB_Name = ""frm" & txtFormName.Text & """"
  Print #nFileHnd, "Attribute VB_Creatable = False"
  Print #nFileHnd, "Attribute VB_Exposed = False"
  Print #nFileHnd, "Option Explicit"
  Print #nFileHnd, ""
  'add the code to the form
  WriteFrmCode nFileHnd
  Close nFileHnd

  'add the new form to the project
  gobjIDEAppInst.ActiveProject.AddFile gobjIDEAppInst.LastUsedPath & "\" & txtFormName & ".FRM"

  'set the form back to defaults
  txtFormName.Text = ""
  cboRecordSource.Text = ""
  'try to set focus back to the form
  Me.SetFocus
  txtFormName.SetFocus
  Exit Sub

BuildFErr:
  MsgBox Err.Description
  Exit Sub

End Sub


Private Sub lstSQL_Click()
Beep
End Sub

Private Sub optLook_Click(Index As Integer)
iScreenStyle = Index
End Sub